-- | UI.hs

module UI where

import Buffers
import Config
import Misc

import Graphics.Vty
import Graphics.Vty.Picture

import Data.List.Split

import Data.Maybe

-- | Render all user interface.
renderScreen vty sx sy configList buffersList curBuf cmd status =
    let screen = pic_for_image $ renderInfoLine sx configList
                                <->
                                renderMain sx sy configList buffersList curBuf
                                <->
                                renderStatusLine sx configList status
                                <->
                                renderCmdLine sx configList cmd
    in update vty screen

-------------------------------------------------
renderInfoLine :: Int -> [(String, String)] -> Image
renderInfoLine sx configList =
    char_fill info_color ' ' sx 1
      where info_color = getColorAttr "info_color" configList

-------------------------------------------------
renderMain sx sy configList buffersList curBuf =
  foldl1 (<->) $
    map renderLine $ zip (take' (sy - 3) Empty    (drop (if sy - 3 - curBuf - 1 < 0 then curBuf - sy + 4 else 0) buffersList))
                         (drop' (sy - 3) (msg_color, "") msgs)
    where
      cBuf = buffersList!!curBuf
      renderLine (buf, (msg_attr, msg)) =
        let attr' = if cBuf == buf then buffer_hicolor else buffer_color
        in renderString attr' (take' buffer_width ' ' (getBufStr buf))
           <|>
           char system_color '│'
           <|>
           renderString msg_attr (take' (sx - buffer_width - 1) ' ' msg)

      -- msgs from buffer content, splitted by '\n' and screen width
      msgs = concat $ map splCnt $ cnt cBuf
        where
          splCnt (Msg ms) = splMsg msg_color ms
          splCnt (MyMsg ms) = splMsg mymsg_color ms
          splCnt (HistoryMsg ms) = splMsg history_color ms
          splCnt (UnknownMsg ms) = splMsg unknown_color ms

          splMsg color = map ((,) color) .  concat .
                           map (chunk' (sx - buffer_width - 1)) . sepBy "\n"
          chunk' _   ""  = [""]
          chunk' num str = chunk num str

          cnt :: (RosterElement a) => a -> [Content]
          cnt el = contents el

      getBufStr (BufferHelp _) = "[help]"
      getBufStr (BufferAccount name acc)
        | isJust    $ connection acc =        "[o]   " ++ name
        | isNothing $ connection acc =        "[_]   " ++ name
      getBufStr (BufferChat      _ name _) =  "  [->]" ++ name
      getBufStr (BufferGroupchat _ name gc) = 
			getBufAction gc ++  " [C] " ++ name
      getBufStr (BufferGroup _ name      ) =  " [>]  " ++ name
      getBufStr (BufferSubchat _ _ name _) =  "  [->]" ++ name
      getBufStr (BufferRosterItem _ _ ri) =  
    			let name = itemName ri in
			getBufAction ri 
				++ case itemStatus ri of
					StatusOffline msg -> " [_] " ++ name
					StatusOnline  msg -> " [O] " ++ name
					StatusAway    msg -> " [A] " ++ name
					StatusChat    msg -> " [F] " ++ name
					StatusDND     msg -> " [D] " ++ name
					StatusXA      msg -> " [N] " ++ name
					_                 -> " [*] " ++ name
      getBufStr Empty = ""
      getBufStr _ = ""

      getBufAction :: (RosterElement a) => a -> String
      getBufAction ri =
	  	case getAlert ri of
			AlertNone -> " "
			AlertNotify -> "+"
			AlertUrgent -> "#"
			_ -> " "

      buffer_hicolor = getColorAttr "buffer_hicolor" configList
      buffer_color = getColorAttr "buffer_color" configList
      system_color = getColorAttr "system_color" configList
      msg_color = getColorAttr "msg_color" configList
      mymsg_color = getColorAttr "mymsg_color" configList
      history_color = getColorAttr "history_color" configList
      unknown_color = getColorAttr "unknown_color" configList
      buffer_width = let df = 20
                         bw = getMaybeValue "buffer_width" configList df
                     in if bw < 0 || bw > sx - 2 then df else bw

-------------------------------------------------
renderStatusLine :: Int -> [(String, String)] -> Status -> Image
renderStatusLine sx configList status =
    renderString color (take' sx ' ' str)
      where
        (str, color) =
          case status of
            StatusInfo info -> (info, status_icolor)
            StatusError err -> (err, status_ecolor)
        status_icolor = getColorAttr "status_icolor" configList
        status_ecolor = getColorAttr "status_ecolor" configList

-------------------------------------------------
renderCmdLine :: Int -> [(String, String)] -> String -> Image
renderCmdLine sx configList cmd =
    renderString system_color (drop' sx ' ' cmd)
      where system_color = getColorAttr "system_color" configList

-- | Helper functions.
renderString :: Attr -> String -> Image
renderString a = horiz_cat . map (char a)

take' n add lst = if length lst < n
                  then lst ++ replicate (n - length lst) add
                  else take n lst

drop' n add lst = if length lst < n
                  then lst ++ replicate (n - length lst) add
                  else reverse $ take n (reverse lst)

getColorAttr :: String -> [(String, String)] -> Attr
getColorAttr name configList =
    let (fg, bg) = getMaybeValue name configList (white, black)
    in def_attr `with_fore_color` fg `with_back_color` bg

getMaybeValue :: Read a => String -> [(String, String)] -> a -> a
getMaybeValue name configList value' =
    maybe value' id (readMaybe $ getConfigValue name configList)
